home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CU Amiga Super CD-ROM 19
/
CU Amiga Magazine's Super CD-ROM 19 (1998)(EMAP Images)(GB)[!][issue 1998-02].iso
/
CUCD
/
Utilities
/
Scion
/
ARexx
/
PedigreeGuide.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1997-09-24
|
26KB
|
734 lines
/*****************************************************************************
PedigreeGuide.rexx by Ron Goertz, 223 NW Clay Ct, Pullman, WA 99163
$VER: PedigreeGuide 1.02 (11 Jul 1996)
An ARexx script to make an AmigaGuide hypertext in the format of a pedigree
chart based on the current IRN of an open ScionGenealogist data base.
Derived from "Scion2Guide.rexx" by Robbie Akins.
*****************************************************************************/
options results
signal on IOERR
arg outval
do while outval = '?'
writeln(stdout, "NOGUI/S - turns off GUI")
pull outval
end
/* Check if Scion is running */
if ~show('P','SCIONGEN') then do
say 'Please start the SCION program BEFORE using this script!'
EXIT
end
Address "SCIONGEN" /* Point at Scion Genealogist port */
/* Initialize variables */
DefaultViewer = 'Display' /* Default viewer if pre- v4.09 */
TempFile = 'ram:ScionTempFile' /* Used for Name List */
PrevGen = 0 /* Used in building pedigree */
PedigreeLine = 2 /* Used for links back to pedigree */
MaxLen.1 = 22 /* Length of buttons in Name List */
MaxLen.3 = 30 /* Length of all other name buttons */
EndReason.0 = 'an unknown reason' /* Reasons for marriages ending */
EndReason.1 = 'an unknown reason'
EndReason.2 = 'divorce'
EndReason.3 = 'separation'
EndReason.4 = 'annulment'
EndReason.5 = 'death'
'GETPROGVERSION'; Version = result
'GETDBName'; DBName = result
'GETCURRENTIRN'; CurrentIRN = result
'GETDBPATH'; DBPath = result
/* add libraries */
if exists('libs:rexxreqtools.library') then do
call addlib('rexxreqtools.library',0,-30,0)
usereq = 1
end
else usereq = 0
if exists('libs:rexxarplib.library') then do
call addlib('rexxarplib.library',0,-30,0)
showprogress = 1
end
else showprogress = 0
if outval == "NOGUI" | outval == 'NOREQ' then do
usereq = 0
showprogress = 0
end
/*** Start program itself ***/
if Version > 4.08 then do
'GETVIEWER'; Viewer = result
end
if Viewer == '' then Viewer = DefaultViewer
if Version < 4.07 then do
if usereq == 1 then
rtezrequest('Requires Scion Version 4.07 (or greater)','Cancel','PedigreeGuide Message:')
else say 'Requires Scion Version 4.07 (or greater)'
exit
end
EXISTPERSON CurrentIRN
if result ~= 'YES' then exit
lastchar = right(DBPath,1)
if lastchar ~= ":" then DBPath = DBPath'/' /* If path does not end with a ":", append a "/" */
/*** Get output location ***/
if usereq == 1 then do
outfile = rtfilerequest('RAM:','Pedigree.guide','Select Path and Name for Guide:',,'rtfi_buffer=true', choice)
if choice == 0 | outfile == '' then EXIT
end
else do
writech(stdout, 'Enter Path and Name for Guide: ')
parse pull outfile
if outfile == '' then EXIT
end
lastcolon = LastPos(':', outfile)
lastslash = lastpos('/', outfile)
filename = substr(outfile,max(lastcolon, lastslash) + 1)
/*** Open file for writing and initialize with guide information ***/
if ~Open('PedigreeFile',outfile,'w') then do
if usereq == 1 then do
call rtezrequest('Unable to open 'outfile' for writing;'|| '0A'x ||,
'check for other processes using this file.')
exit
end
else do
say 'Unable to open 'outfile' for writing; check for other processes using this file.'
exit
end
end
WriteLn('PedigreeFile','@database "'filename'"')
WriteLn('PedigreeFile','@Index NameList')
WriteLn('PedigreeFile','@author "Ronald Goertz"')
WriteLn('PedigreeFile','@(c) "Copyright © 1995 Ronald Goertz"')
WriteLn('PedigreeFile','@$VER: PedigreeGuide V1.02 (11 Jul 1996)')
WriteLn('PedigreeFile','@width 77')
/*** Count generations in database ***/
ReportProgress('Counting generations ...')
MaxGen = 0
CountGen(CurrentIRN,'P',0)
CountGen(CurrentIRN,'M',0)
if showprogress == 1 then Postmsg()
/*** From user, get number of generations to process ***/
if usereq == 1 then do
RequestedGen = rtgetlong(MaxGen,'How many of the' || '0A'x ||,
MaxGen' generations' || '0A'x ||,
'should be included?','PedigreeGuide',,,choice)
if choice == 0 | RequestedGen == 0 | RequestedGen == '' then exit
end
else do
writech(stdout, 'How many of the 'MaxGen' generations should be included? ')
pull RequestedGen
if RequestedGen == 0 | RequestedGen == '' then exit
end
if RequestedGen < MaxGen then MaxGen = RequestedGen
/*** Make pedigree node of guide ***/
do i = 1 to MaxGen
Gen.i = ' '
end
ReportProgress('Building Pedigree ...')
WriteLn('PedigreeFile', '@NODE Main "Pedigree"')
WriteLn('PedigreeFile','')
WriteLn('PedigreeFile','@{" Names " LINK NameList}')
WriteLn('PedigreeFile','')
AddAncestor(CurrentIRN,'P',0)
'GETLASTNAME' CurrentIRN; LASTNAME = result
'GETFIRSTNAME' CurrentIRN; FIRSTNAME = result
'GETBIRTHDATE' CurrentIRN; BIRTHDATE = right(result,11)
'GETDEATHDATE' CurrentIRN; DEATHDATE = right(result,11)
FULLNAME = TransformName(LASTNAME, FIRSTNAME)
WriteLn('PedigreeFile',' |')
WriteCh('PedigreeFile','@{" 'left(FULLNAME, MaxLen.3)' " LINK P'CurrentIRN'}')
IF BIRTHDATE ~= "" THEN WriteCh('PedigreeFile',' b:'BIRTHDATE)
IF DEATHDATE ~= "" THEN WriteCh('PedigreeFile',' d:'DEATHDATE)
WriteLn('PedigreeFile','')
PedigreeLine = PedigreeLine + 2
Node.CurrentIRN = PedigreeLine
AddAncestor(CurrentIRN,'M',0)
WriteLn('PedigreeFile','@ENDNODE')
WriteLn('PedigreeFile','')
/*** Add individual nodes to guide ***/
if showprogress == 0 then say 'Processing records ...'
Open('NameList', TempFile, 'w')
call AddNodes(CurrentIRN, 'P', 0)
call AddNodes(CurrentIRN, 'M', 0)
Close('NameList')
/*** Create name list node ***/
ReportProgress('Creating list of names ...')
ADDRESS COMMAND sort TempFile TempFile
WriteLn('PedigreeFile', '@NODE NameList "Name List"')
WriteLn('PedigreeFile','')
WriteLn('PedigreeFile','@{" Pedigree " LINK Main}')
WriteLn('PedigreeFile','')
LinesSoFar = 4
LNameLen = 0
/*** Count number of family names & number of records for each ***/
Open('SortedList',TempFile,'r')
LName = '~'
Families = 0
do while ~EOF('SortedList')
line = ReadLn('SortedList')
if line == '' then leave
LastName = left(line, pos(',', line) - 1)
if LastName =='' then LastName = '0'
if LastName ~= LName then do
if length(LastName) > LNameLen then LNameLen = length(LastName)
Families = Families + 1
LName = LastName
FamilyName.Families = LName
NameCount.Families = 0
end
NameCount.Families = NameCount.Families + 1
end
Close('SortedList')
if FamilyName.1 == '0' then do
FirstName = 2
LinesSoFar = LinesSoFar + NameCount.1 + 2
end
else FirstName = 1
/*** Calculate links per row and number of link rows ***/
LinksPerRow = trunc(75 / (LNameLen + 3))
row = trunc((Families - FirstName) / LinksPerRow, 0)
if (Families - FirstName) // LinksPerRow ~= 0 then row = row + 1
/*** Add familyname links ***/
LinesSoFar = LinesSoFar + row
row = 0
column = 0
do i = FirstName to Families
WriteCh('PedigreeFile', '@{" 'center(FamilyName.i, LNameLen)' " LINK NameList 'LinesSoFar'} ')
LinesSoFar = LinesSoFar + NameCount.i + 2
NL = 0
column = column + 1
if column == LinksPerRow then do
WriteLn('PedigreeFile', '')
row = row + 1
column = 0
NL = 1
end
end
if NL == 0 then do
WriteLn('PedigreeFile', '')
row = row + 1
end
/*** Add record links ***/
Open('SortedList',TempFile,'r')
LName = ''
Entries = 0
do while ~EOF('SortedList')
line = ReadLn('SortedList')
if line == '' then leave
LastName = left(line, pos(',', line) - 1)
if LastName == '' then LastName = 'Last Name Unknown'
FirstName = substr(line, pos(',', line) + 1)
FirstName = strip(left(FirstName, pos('|',FirstName) - 1))
Birthday = substr(line, pos('|', line) + 1)
Birthday = strip(left(Birthday, pos('>',Birthday) - 1))
IRN = substr(line, pos('>',line) + 1)
if LastName ~= LName then do
LName = LastName
WriteLn('PedigreeFile','')
WriteLn('PedigreeFile', LastName)
end
WriteLn('PedigreeFile', ' @{" 'left(FirstName, MaxLen.1)' " LINK P'IRN'} 'Birthday)
Entries = Entries + 1
end
Close('SortedList')
WriteLn('PedigreeFile','')
WriteLn('PedigreeFile','('Entries' people added to 'filename')')
WriteLn('PedigreeFile','')
WriteLn('PedigreeFile','@ENDNODE')
Close('PedigreeFile')
ADDRESS COMMAND 'delete >NIL: 'TempFile
if showprogress == 1 then PostMsg()
if usereq == 1 then call rtezrequest(filename 'complete.')
else say filename' complete.'
exit
end
/*************************************/
/* Find individuals to add to guide */
/*************************************/
AddNodes:PROCEDURE EXPOSE MaxGen MaxLen. DBPath DBName Viewer Node. showprogress PedigreeLine EndReason.
PARSE ARG irn, familyside, generation
generation = generation + 1
'GETPARENTS' irn
if familyside == 'P' then 'GETPRINCIPAL' result
else 'GETSPOUSE' result
pirn = result
if pirn ~= '' then do
if generation < MaxGen then AddNodes(pirn,'P',generation)
AddInfo(pirn, generation)
if generation < MaxGen then AddNodes(pirn,'M',generation)
end
return 0
/*********************************/
/* Add inividual nodes to guide */
/*********************************/
AddInfo: PROCEDURE EXPOSE MaxGen DBPath DBName Viewer showprogress PedigreeLine MaxLen. Node. EndReason.
PARSE ARG irn, generation
if Node.irn == 1 | Node.irn < 0 then return 0
'GETLASTNAME' irn; LASTNAME = result
'GETFIRSTNAME' irn; FIRSTNAME = result
'GETPARENTS' irn; PARENTS = result
'GETNUMMARRY' irn; MARRIAGES = result
'GETTOTALCHILD' irn; TOTALCHILDREN = result
'GETBIRTHDATE' irn; BIRTHDATE = result
'GETBIRTHPLACE' irn; BIRTHPLACE = result
'GETDEATHDATE' irn; DEATHDATE = result
'GETDEATHPLACE' irn; DEATHPLACE = result
'GETBURIALDATE' irn; BURIALDATE = result
'GETBURIALPLACE' irn; BURIALPLACE = result
'GETOCCUPATION' irn; OCCUPATION = result
'GETEDUCATION' irn; EDUCATION = result
'GETRELIGION' irn; RELIGION = result
'GETDIEDOF' irn; DIEDOF = result
'GETPERSCOMMENT' irn; COMMENT = result
'GETPERSREFS' irn; REFS = result
FULLNAME = TransformName(LASTNAME, FIRSTNAME)
FootNote = 0
if showprogress == 1 then Postmsg(10, 10, "\\Processing "||FULLNAME, "SCIONGEN")
if datatype(right(BIRTHDATE,4)) == 'NUM' then Birthday = '( 'right(BIRTHDATE,4)' - '
else Birthday = '( - '
if datatype(right(DEATHDATE,4)) == 'NUM' then Birthday = Birthday''right(DEATHDATE,4)' )'
else Birthday = Birthday')'
WriteLn('NameList', LASTNAME', 'FIRSTNAME'|'Birthday'>'irn)
WriteLn('PedigreeFile', '@NODE P'irn' "'FULLNAME'"')
/*** Add links ***/
WriteLn('PedigreeFile','')
WriteCh('PedigreeFile',' @{" Pedigree " LINK Main')
if datatype(Node.irn) == 'NUM' then WriteCh('PedigreeFile',' 'Node.irn)
WriteLn('PedigreeFile','} @{" Names " LINK NameList}')
if datatype(Node.irn) == 'NUM' then Node.irn = -Node.irn
else Node.irn = 1
LinkLine = ''
if Exists(DBPath'PN'irn'.'DBName) then do
LinkLine = ' @{" Personal Note " LINK P'irn'Note}'
AddPNote = 1
end
else AddPNote = 0
if Exists(DBPath'PP'irn'.'DBName) then
LinkLine = LinkLine' @{" Individual Picture " RXS "address command '"'" Viewer' 'DBPath'PP'irn'.'DBName"'"'"}'
if LinkLine ~= '' then WriteCh('PedigreeFile',LinkLine)
LinkLine = ''
if Exists(DBPath'FN'PARENTS'.'DBName) then do
LinkLine = ' @{" Family Note " LINK F'PARENTS'Note}'
AddFNote = 1
end
else AddFNote = 0
if Exists(DBPath'FP'PARENTS'.'DBName) then
LinkLine = LinkLine' @{" Family Picture " RXS "address command '"'" Viewer' 'DBPath'FP'PARENTS'.'DBName"'"'"}'
if LinkLine ~= '' then WriteLn('PedigreeFile',LinkLine)
/*** Add personal information ***/
WriteLn('PedigreeFile','')
WriteLn('PedigreeFile', '@{b}'trim(center(FULLNAME, 75))'@{ub}')
WriteLn('PedigreeFile','')
if BIRTHDATE || BIRTHPLACE ~= "" then do
WriteCh('PedigreeFile','Born ')
if BIRTHDATE ~= "" then WriteCh('PedigreeFile','on 'BIRTHDATE)
if BIRTHPLACE ~= "" then WriteCh('PedigreeFile',' in 'BIRTHPLACE)
WriteLn('PedigreeFile','')
end
if DEATHDATE || DEATHPLACE ~= "" then do
WriteCh('PedigreeFile','Died ')
if DEATHDATE ~= "" then WriteCh('PedigreeFile','on 'DEATHDATE)
if DEATHPLACE ~= "" then WriteCh('PedigreeFile',' in 'DEATHPLACE)
WriteLn('PedigreeFile','')
end
if BURIALDATE || BURIALPLACE ~= "" then do
WriteCh('PedigreeFile','Buried ')
if BURIALDATE ~= "" then WriteCh('PedigreeFile','on 'BURIALDATE)
if BURIALPLACE ~= "" then WriteCh('PedigreeFile',' in 'BURIALPLACE)
WriteLn('PedigreeFile','')
end
WriteLn('PedigreeFile','')
if DIEDOF ~= "" then WriteLn('PedigreeFile', " Died of: "DIEDOF)
if OCCUPATION ~= "" then WriteLn('PedigreeFile',"Occupation: "OCCUPATION)
if EDUCATION ~= "" then WriteLn('PedigreeFile', " Education: "EDUCATION)
if RELIGION ~= "" then WriteLn('PedigreeFile', " Religion: "RELIGION)
if COMMENT ~= "" then WriteLn('PedigreeFile', " Comments: "COMMENT)
if REFS ~= "" then WriteLn('PedigreeFile', "References: "REFS)
/*** Add parents ***/
WriteLn('PedigreeFile',COPIES("=", 75))
WriteLn('PedigreeFile','')
if MARRIAGES = 1 then SHeading = 'Spouse'
else if MARRIAGES > 1 then SHeading = 'Spouses'
else SHeading = ''
if TOTALCHILDREN = 1 then CHeading = 'Child'
else if TOTALCHILDREN > 1 then CHeading = 'Children'
else CHeading = ''
if SHeading == '' & CHeading == '' then Heading = ''
else if SHeading == '' | CHeading == '' then Heading = 'and 'SHeading''CHeading
else Heading = ', 'SHeading', and 'CHeading
WriteLn('PedigreeFile','Parents'Heading' of 'FULLNAME)
WriteLn('PedigreeFile','')
if PARENTS ~> 0 then do
WriteLn('PedigreeFile','Unknown -- Unknown')
PCHILDREN = 0
end
else do
prefix = ' |'
'GETPRINCIPAL' PARENTS; IRN.1 = result
'GETSPOUSE' PARENTS; IRN.2 = result
'GETNUMCHILD' PARENTS; PCHILDREN = result
'GETSEX' IRN.1
if result == 'F' then do
temp = IRN.1
IRN.1 = IRN.2
IRN.2 = temp
end
do i = 1 to 2
if IRN.i == '' then INFO = 'Unknown'
else do
'GETLASTNAME' IRN.i; PLASTNAME.i = result
'GETFIRSTNAME' IRN.i; PFIRSTNAME = result
PFULLNAME = TransformName(PLASTNAME.i, PFIRSTNAME)
if generation < MaxGen then INFO = '@{" 'center(PFULLNAME,MaxLen.3)' " LINK P'IRN.i'}'
else INFO = PFULLNAME
end
if i == 1 then WriteCh('PedigreeFile',INFO' -- ')
else WriteLn('PedigreeFile',INFO)
end
WriteLn('PedigreeFile',Prefix)
/*** Add siblings ***/
do i = 0 to PCHILDREN - 1
'GETCHILD' PARENTS i; CHILD = result
'GETLASTNAME' CHILD; CLASTNAME = result
'GETFIRSTNAME' CHILD; CFIRSTNAME = result
'GETBIRTHDATE' CHILD; CBIRTHDATE = result
'GETDEATHDATE' CHILD; CDEATHDATE = result
CNAME = TransformName(CLASTNAME, CFIRSTNAME)
PedMark = ' '
if datatype(Node.CHILD) = 'NUM' then
if abs(Node.CHILD) > 1 then do
PedMark = '>'
FootNote = 1
end
if i == PCHILDREN - 1 then Prefix = overlay('+',Prefix,3)
if CHILD == irn & MARRIAGES > 0 THEN WriteCh('PedigreeFile',overlay('+-',Prefix)'--- @{b}'PedMark' 'left(CNAME,MaxLen.3)'@{ub} ')
else if CHILD == irn & MARRIAGES == 0 THEN WriteCh('PedigreeFile',Prefix'--- @{b}'PedMark' 'left(CNAME,MaxLen.3)'@{ub} ')
else WriteCh('PedigreeFile',Prefix'--- @{"'PedMark' 'left(CNAME,MaxLen.3)' " LINK P'CHILD'}')
if CBIRTHDATE ~= "" then WriteCh('PedigreeFile',' b:'CBIRTHDATE)
if CDEATHDATE ~= "" then WriteCh('PedigreeFile',' d:'CDEATHDATE)
WriteLn('PedigreeFile','')
if CHILD == irn & MARRIAGES > 0 then Prefix = overlay('|',Prefix)
end
end
/*** Add marriages ***/
if MARRIAGES > 0 then do
Prefix = '|'
do i = 0 to MARRIAGES - 1
if i == MARRIAGES - 1 then Prefix = ' '
WriteLn('PedigreeFile','|')
WriteLn('PedigreeFile','|')
'GETMARRIAGE' irn i; FGRN = result
'GETNUMCHILD' FGRN; CHILDREN = result
'GETSPOUSE' FGRN; SPOUSE = result
if SPOUSE = irn then do
'GETPRINCIPAL' FGRN; SPOUSE = result
end
'GETLASTNAME' SPOUSE; SLASTNAME = result
'GETFIRSTNAME' SPOUSE; SFIRSTNAME = result
'GETBIRTHDATE' SPOUSE; SBIRTHDATE = result
'GETDEATHDATE' SPOUSE; SDEATHDATE = result
'GETENGAGEDATE' FGRN; ENGAGEDATE = result
'GETENGAGEPLACE' FGRN; ENGAGEPLACE = result
'GETMARRYDATE' FGRN; MARRYDATE = result
'GETMARRYPLACE' FGRN; MARRYPLACE = result
'GETENDDATE' FGRN; ENDDATE = result
'GETENDPLACE' FGRN; ENDPLACE = result
'GETENDING' FGRN; REASON = result
'GETCELEBRANT' FGRN; CELEBRANT = result
'GETWITNESS' FGRN; WITNESS = result
'GETFAMCOMMENT' FGRN; FAMCOMMENT = result
'GETFAMREFS' FGRN; FAMREFS = result
if SPOUSE > 0 then SFULLNAME = TransformName(SLASTNAME, SFIRSTNAME)
else SFULLNAME = 'Unknown'
if CHILDREN > 0 then CPrefix = '|'
else CPrefix = ' '
if generation > 0 & SPOUSE > 0 then
WriteCh('PedigreeFile','+----- @{" 'left(SFULLNAME,MaxLen.3)' " LINK P'SPOUSE'}')
else
WriteCh('PedigreeFile','+----- 'left(SFULLNAME,MaxLen.3)' ')
if SBIRTHDATE ~= "" then WriteCh('PedigreeFile',' b:'SBIRTHDATE)
if SDEATHDATE ~= "" then WriteCh('PedigreeFile',' d:'SDEATHDATE)
WriteLn('PedigreeFile','')
if ENGAGEDATE ~= "" | ENGAGEPLACE ~= "" then do
WriteCh('PedigreeFile',Prefix' 'CPrefix' Engaged ')
if ENGAGEDATE ~= "" then WriteCh('PedigreeFile','on 'ENGAGEDATE' ')
if ENGAGEPLACE ~= "" then WriteCh('PedigreeFile','in 'ENGAGEPLACE)
WriteLn('PedigreeFile','')
end
if MARRYDATE ~= "" | MARRYPLACE ~= "" then do
WriteCh('PedigreeFile',Prefix' 'CPrefix' Married ')
if MARRYDATE ~= "" then WriteCh('PedigreeFile','on 'MARRYDATE' ')
if MARRYPLACE ~= "" then WriteCh('PedigreeFile','in 'MARRYPLACE)
WriteLn('PedigreeFile','')
end
if CELEBRANT ~= '' then WriteLn('PedigreeFile',Prefix' 'CPrefix' Married by 'CELEBRANT)
if WITNESS ~= '' then WriteLn('PedigreeFile',Prefix' 'CPrefix' Witnessed by 'WITNESS)
if ENDDATE ~= "" | ENDPLACE ~= "" then do
WriteCh('PedigreeFile',Prefix' 'CPrefix' Ended ')
if ENDDATE ~= "" then WriteCh('PedigreeFile','on 'ENDDATE' ')
if ENDPLACE ~= "" then WriteCh('PedigreeFile','in 'ENDPLACE' ')
WriteLn('PedigreeFile','due to 'EndReason.REASON)
end
if FAMREFS ~= '' then WriteLn('PedigreeFile',Prefix' 'CPrefix' References: 'FAMREFS)
if FAMCOMMENT ~= '' then WriteLn('PedigreeFile',Prefix' 'CPrefix' Comment: 'FAMCOMMENT)
/*** Add children ***/
if CHILDREN > 0 then do
WriteLn('PedigreeFile',Prefix' 'CPrefix)
do j = 0 to CHILDREN - 1
'GETCHILD' FGRN j; CHILD = result
'GETLASTNAME' CHILD; CLASTNAME = result
'GETFIRSTNAME' CHILD; CFIRSTNAME = result
'GETBIRTHDATE' CHILD; CBIRTHDATE = result
'GETDEATHDATE' CHILD; CDEATHDATE = result
CNAME = TransformName(CLASTNAME, CFIRSTNAME)
PedMark = ' '
if datatype(Node.CHILD) = 'NUM' then
if abs(Node.CHILD) > 1 then do
PedMark = '>'
FootNote = 1
end
if j == CHILDREN - 1 then CPrefix = '+'
if generation >0 then
WriteCh('PedigreeFile',Prefix' 'CPrefix'--- @{"'PedMark' 'left(CNAME,MaxLen.3)'" LINK P'CHILD'}')
else
WriteCh('PedigreeFile',Prefix' 'CPrefix'--- 'left(CNAME,MaxLen.3))
if CBIRTHDATE ~= "" then WriteCh('PedigreeFile',' b:'CBIRTHDATE)
if CDEATHDATE ~= "" then WriteCh('PedigreeFile',' d:'CDEATHDATE)
WriteLn('PedigreeFile','')
end
end
end
end
if FootNote == 1 then do
WriteLn('PedigreeFile','')
WriteLn('PedigreeFile','')
WriteLn('PedigreeFile','( > indicates child listed in pedigree )')
end
WriteLn('PedigreeFile', '@ENDNODE')
WriteLn('PedigreeFile','')
/*** Add note nodes if necessary ***/
if AddPNote then do
Open('INDLNOTE',DBPath'PN'irn'.'DBName,'r')
WriteLn('PedigreeFile','@NODE P'irn'Note')
do while ~EOF('INDLNOTE')
line = ReadLn('INDLNOTE')
WriteLn('PedigreeFile',line)
end
WriteLn('PedigreeFile','@ENDNODE')
WriteLn('PedigreeFile','')
Close('INDLNOTE')
end
if AddFNote then do
Open('FAMNOTE',DBPath'FN'PARENTS'.'DBName,'r')
WriteLn('PedigreeFile','@NODE F'PARENTS'Note')
do while ~EOF('FAMNOTE')
line = ReadLn('FAMNOTE')
WriteLn('PedigreeFile',line)
end
WriteLn('PedigreeFile','@ENDNODE')
WriteLn('PedigreeFile','')
Close('FAMNOTE')
end
/*** Add sibling nodes if necessary ***/
if PCHILDREN > 1 then do
do i = 0 to PCHILDREN - 1
'GETCHILD' PARENTS i; CHILD = result
AddInfo(CHILD, generation)
end
end
/*** Add spouse and child nodes if necessary ***/
if MARRIAGES > 0 & generation > 0 then do
do i = 0 to MARRIAGES - 1
'GETMARRIAGE' irn i; FGRN = result
'GETNUMCHILD' FGRN; CHILDREN = result
'GETSPOUSE' FGRN; SPOUSE = result
if SPOUSE = irn then do
'GETPRINCIPAL' FGRN; SPOUSE = result
end
if SPOUSE > 0 then AddInfo(SPOUSE, generation)
if CHILDREN > 0 then do
do j = 0 to CHILDREN - 1
'GETCHILD' FGRN j; CHILD = result
AddInfo(CHILD, generation - 1)
end
end
end
end
RETURN 0
/**********************/
/* Count generations */
/**********************/
CountGen:PROCEDURE EXPOSE MaxGen
PARSE ARG irn, familyside, generation
generation = generation + 1
'GETPARENTS' irn
if familyside == 'P' then 'GETPRINCIPAL' result
else 'GETSPOUSE' result
pirn = result
if pirn ~= '' then do
CountGen(pirn,'P',generation)
if generation > MaxGen then MaxGen = generation
CountGen(pirn,'M',generation)
end
return 0
/*******************************/
/* Add people to pedigree node */
/*******************************/
AddAncestor: PROCEDURE EXPOSE MaxGen PrevGen PedigreeLine MaxLen. Gen. Node..
PARSE ARG irn, familyside, generation
generation = generation + 1
'GETPARENTS' irn; PARENTS = result
'GETPRINCIPAL' PARENTS; PRINCIPAL = result
'GETSPOUSE' PARENTS; SPOUSE = result
'GETSEX' PRINCIPAL
if familyside == 'P' then do
if result == 'M' then pirn = PRINCIPAL
else pirn = SPOUSE
end
else do
if result == 'F' then pirn = PRINCIPAL
else pirn = SPOUSE
end
if pirn ~= '' then do
if generation < MaxGen then AddAncestor(pirn,'P',generation)
'GETLASTNAME' pirn; LASTNAME = result
'GETFIRSTNAME' pirn; FIRSTNAME = result
'GETBIRTHDATE' pirn; BIRTHDATE = right(result,11)
'GETDEATHDATE' pirn; DEATHDATE = right(result,11)
FULLNAME = TransformName(LASTNAME, FIRSTNAME)
if PrevGen < generation then DoTo = generation
else DoTo = PrevGen
prefix = ''
do i = 1 to DoTo
prefix = prefix Gen.i
end
WriteLn('PedigreeFile',prefix)
prefix = ''
do i = 1 to generation - 1
prefix = prefix Gen.i
end
WriteCh('PedigreeFile',prefix' +---@{" 'left(FULLNAME,MaxLen.3)' " LINK P'pirn'}')
IF BIRTHDATE ~= "" THEN WriteCh('PedigreeFile',' b:'BIRTHDATE)
IF DEATHDATE ~= "" THEN WriteCh('PedigreeFile',' d:'DEATHDATE)
WriteLn('PedigreeFile','')
PedigreeLine = PedigreeLine + 2
Node.pirn = PedigreeLine
if familyside = 'P' then Gen.generation = '| '
else Gen.Generation = ' '
PrevGen = generation
if generation < MaxGen then AddAncestor(pirn,'M',generation)
end
else if familyside == 'P' then Gen.generation = '| '
else if familyside == 'M' then Gen.Generation = ' '
return 0
/*******************************************************************************************************/
TransformName: PROCEDURE
parse arg LName, FName
CommaLoc = pos(',', FName)
if CommaLoc == 0 then Name = FName' 'LName
else Name = left(FName, CommaLoc - 1)' 'LName''substr(FName, CommaLoc)
return Name
ReportProgress:
parse arg str
if showprogress == 1 then
Postmsg(10, 10, "PedigreeGuide by Ron Goertz \Database: "||DBName||"\"||str, "SCIONGEN")
else say str
return 0
IOERR:
bline = SIGL
say "I/O error #"||RC||" detected in line "||bline||":"
say sourceline(bline)
if showprogress then Postmsg()
EXIT